home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / p / paintcol / compress / ca_pack.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1996-10-30  |  2.5 KB  |  115 lines
  1. '
  2. '
  3. ' CRACK ART 'CA_PACK'
  4. '
  5. ' Kompressionsroutine für CA?-Bilder
  6. '
  7. ' © Detlef Röttger & Jan Borchers 1989-91
  8. '
  9. '
  10. ' ## INLINE:
  11. ' $0000: 60 1a 00 00 01 fe 00 00 00 30 00 00 00 00 00 00 
  12. ' $0010: 00 00 00 00 00 00 00 00 00 00 00 00 48 e7 7f fe 
  13. ' $0020: 4c ef 03 00 00 3c 22 6f 00 40 24 49 30 3c 00 ff 
  14. ' $0030: 42 5a 51 c8 ff fc 24 48 30 3c 7c ff 42 41 12 1a 
  15. ' $0040: d2 41 52 71 10 00 51 c8 ff f4 24 49 45 ea 02 00 
  16. ' $0050: 32 3c 7e f4 30 3c 00 fc 34 22 b4 41 6c 06 36 00 
  17. ' $0060: 32 02 67 04 51 c8 ff f2 56 43 3e 03 24 49 32 3c 
  18. ' $0070: ff ff 30 3c 00 ff 34 1a b4 41 6f 04 36 00 32 02 
  19. ' $0080: 51 c8 ff f4 44 43 06 43 00 ff 3c 03 20 6f 00 3c 
  20. ' $0090: 45 e8 7d 00 38 3c 7d 00 4d fa 01 80 2a 5e bb fc 
  21. ' $00a0: 00 00 00 00 67 5c bb fc ff ff ff ff 67 6e 4c ef 
  22. ' $00b0: 09 00 00 3c 22 48 16 c7 16 c6 36 cd 36 3c 00 04 
  23. ' $00c0: 20 0d 53 40 4a 40 6b 1a 12 11 42 42 d3 cd b3 ca 
  24. ' $00d0: 6d 08 52 88 22 48 53 40 6b 4c b2 11 66 48 52 42 
  25. ' $00e0: 60 ea 52 43 b6 44 6c b4 16 c7 52 43 b6 44 6c ac 
  26. ' $00f0: 16 fc 00 02 52 43 b6 44 6c a2 42 1b 38 03 2a 0d 
  27. ' $0100: 60 9a b8 7c 7d 00 6c 14 38 3c 7d 00 4d fa 01 34 
  28. ' $0110: 2c 85 2d 7c ff ff ff ff 00 04 60 80 70 00 30 04 
  29. ' $0120: 4c df 7f fe 4e 75 4a 40 6a 04 b2 06 67 b4 b2 07 
  30. ' $0130: 66 1c 52 43 b6 44 6c 00 ff 64 16 c7 52 43 b6 44 
  31. ' $0140: 6c 00 ff 5a 16 c7 51 ca ff ea 60 00 ff 78 b4 7c 
  32. ' $0150: 00 02 6e 12 52 43 b6 44 6c 00 ff 42 16 c1 51 ca 
  33. ' $0160: ff f4 60 00 ff 60 b4 7c 00 ff 6e 30 52 43 b6 44 
  34. ' $0170: 6c 00 ff 2a 16 c7 b4 07 66 0a 52 43 b6 44 6c 00 
  35. ' $0180: ff 1c 42 1b 52 43 b6 44 6c 00 ff 12 16 c2 52 43 
  36. ' $0190: b6 44 6c 00 ff 08 16 c1 60 00 ff 2a b2 06 67 42 
  37. ' $01a0: 52 43 b6 44 6c 00 fe f6 16 c7 52 43 b6 44 6c 00 
  38. ' $01b0: fe ec 16 fc 00 01 52 43 b6 44 6c 00 fe e0 38 42 
  39. ' $01c0: e0 4a 16 c2 52 43 b6 44 6c 00 fe d2 34 0c c4 7c 
  40. ' $01d0: 00 ff 16 c2 52 43 b6 44 6c 00 fe c2 16 c1 60 00 
  41. ' $01e0: fe e4 52 43 b6 44 6c 00 fe b4 16 c7 52 43 b6 44 
  42. ' $01f0: 6c 00 fe aa 16 fc 00 02 52 43 b6 44 6c 00 fe 9e 
  43. ' $0200: 38 42 e0 4a 16 c2 52 43 b6 44 6c 00 fe 90 34 0c 
  44. ' $0210: c4 7c 00 ff 16 c2 60 00 fe ac 00 00 00 a0 00 00 
  45. ' $0220: 00 08 00 00 00 50 00 00 00 01 00 00 00 02 00 00 
  46. ' $0230: 00 04 00 00 01 40 00 00 02 80 00 00 01 e0 00 00 
  47. ' $0240: 00 00 00 00 00 a0 ff ff ff ff 00 00 00 00 
  48. ' 590  Bytes.
  49. INLINE ca_pack%,590
  50. '
  51. resolution&=XBIOS(4)                            ! Auflösung holen
  52. IF resolution&>2                                ! keine ST-Auflösung
  53.   END
  54. ENDIF
  55. '
  56. DO
  57.   fpath$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\*.CA"+CHR$(resolution&+49)
  58.   FILESELECT #"SAVE CA",fpath$,"",fname$        ! File auswählen
  59.   CLS
  60.   IF fname$=""                                  ! Abbruch
  61.     END
  62.   ENDIF
  63.   '
  64.   FOR i&=1 TO 50
  65.     DEFFILL RANDOM(16),1,0
  66.     PCIRCLE RANDOM(WORK_OUT(0)),RANDOM(WORK_OUT(1)),RANDOM(50)
  67.   NEXT i&
  68.   '
  69.   buffer$=STRING$(32000,0)                      ! Buffer reservieren
  70.   HIDEM
  71.   len%=C:ca_pack%(L:XBIOS(2),L:V:buffer$)       ! Image packen
  72.   SHOWM
  73.   '
  74.   PRINT AT(1,1);"Bild von 32000 Bytes auf ";len%;" Bytes (";
  75.   PRINT INT(100*len%/32000);"%) gepackt."
  76.   '
  77.   OPEN "O",#1,fname$                            ! File öffnen
  78.   '
  79.   SELECT resolution&
  80.     '
  81.   CASE 0                                        ! Low Res
  82.     header$=STRING$(4+32,0)
  83.     DPOKE V:header$,&H4341                      ! 'CA'-Kennung
  84.     DPOKE V:header$+2,&H100                     ! Low Res gepackt
  85.     FOR i&=0 TO 15                              ! 16 Farben
  86.       DPOKE V:header$+4+i&*2,XBIOS(7,W:i&,W:-1) AND &H777
  87.     NEXT i&
  88.     BPUT #1,V:header$,4+32
  89.     '
  90.   CASE 1                                        ! Med Res
  91.     header$=STRING$(4+8,0)
  92.     DPOKE V:header$,&H4341                      ! 'CA'-Kennung
  93.     DPOKE V:header$+2,&H101                     ! Med Res gepackt
  94.     FOR i&=0 TO 3                               ! 4 Farben
  95.       DPOKE V:header$+4+i&*2,XBIOS(7,W:i&,W:-1) AND &H777
  96.     NEXT i&
  97.     BPUT #1,V:header$,4+8
  98.     '
  99.   CASE 2                                        ! High Res
  100.     header$=STRING$(4,0)
  101.     DPOKE V:header$,&H4341                      ! 'CA'-Kennung
  102.     DPOKE V:header$+2,&H102                     ! High Res gepackt
  103.     BPUT #1,V:header$,4
  104.     '
  105.   ENDSELECT
  106.   '
  107.   BPUT #1,V:buffer$,len%
  108.   CLOSE #1
  109.   '
  110.   WHILE MOUSEK
  111.   WEND
  112.   REPEAT
  113.   UNTIL MOUSEK
  114. LOOP
  115.